home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / utility / sml-mode-3.3b / sml-font.el < prev    next >
Encoding:
Text File  |  1997-08-18  |  7.4 KB  |  192 lines  |  [TEXT/R*ch]
  1. ;;; sml-font.el --- Highlighting for sml-mode using font-lock.
  2. ;;
  3. ;; Copyright (C) 1995 Frederick Knabe
  4. ;;
  5. ;; Author:     Fritz Knabe <knabe@ecrc.de>
  6. ;;             ECRC GmbH, Arabellastr. 17, 81925 Munich, Germany
  7. ;; Created:    26 June 1995
  8. ;; Modified:   14 April 1997, M.J.Morley <mjm@scs.leeds.ac.uk>
  9. ;;             Add a couple of keywords to s-f-l-standard-keywords.
  10. ;;
  11. ;; $Revision: 1.6 $
  12. ;; $Date: 1997/04/29 19:55:40 $
  13. ;;
  14. ;; ====================================================================
  15. ;; This program is free software; you can redistribute it and/or modify
  16. ;; it under the terms of the GNU General Public License as published by
  17. ;; the Free Software Foundation; either version 2 of the License, or
  18. ;; (at your option) any later version.
  19. ;;
  20. ;; This program is distributed in the hope that it will be useful,
  21. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  22. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23. ;; GNU General Public License for more details.
  24. ;;
  25. ;; If you did not receive a copy of the GNU General Public License with
  26. ;; this program, write to the Free Software Foundation, Inc., 675 Mass
  27. ;; Ave, Cambridge, MA 02139, USA.
  28. ;; ====================================================================
  29. ;;
  30. ;;; DESCRIPTION
  31. ;;
  32. ;; This package sets up highlighting of SML using font-lock.  If you
  33. ;; use the new version of font-lock distributed in GNU Emacs, SML's
  34. ;; nested comments as well as its special string escapes will be
  35. ;; handled properly.  The version of font-lock distributed with XEmacs
  36. ;; can also be used, but these special cases will not be handled.
  37. ;;
  38. ;; Should the fontification become incorrect while editing (for
  39. ;; example, when uncommenting), M-x font-lock-fontify-buffer will clear
  40. ;; things up.
  41. ;;
  42. ;; To install (assuming that you use sml-mode 3.1), put the following
  43. ;; in your .emacs:
  44. ;;
  45. ;;       (setq sml-hilite nil)     ; Turn off highlighting based on hilit19
  46. ;;
  47. ;;      ;; For GNU Emacs
  48. ;;       (eval-after-load "sml-mode" '(require 'sml-font))
  49. ;;
  50. ;;       ;; For XEmacs
  51. ;;       (require 'sml-font)
  52. ;;
  53. ;;
  54. ;; Versions 3.2 and later of sml-mode define sml-load-hook (and the
  55. ;; variable sml-hilite is spurious), so you can simply put:
  56. ;;
  57. ;;       (setq sml-load-hook
  58. ;;             '(lambda() "Fontify SML." (require 'sml-font)))
  59. ;;
  60. ;; By default, font-lock will be turned on automatically for every SML
  61. ;; buffer.  If you don't want this, also add the following:
  62. ;;
  63. ;;       (setq sml-font-lock-auto-on nil)
  64. ;;
  65. ;; If you want to add to the keywords that will be fontified, set the
  66. ;; variable sml-font-lock-extra-keywords (see its documentation).
  67. ;;
  68. ;; Thanks to Matthew Morley <morley@gmd.de> for suggestions and fixes.
  69. ;; 
  70.  
  71. (require 'font-lock)
  72.  
  73. (defvar sml-font-lock-auto-on t
  74.   "*If non-nil, turn on font-lock unconditionally for every SML buffer.")
  75.  
  76. (defvar sml-font-lock-extra-keywords nil
  77.   ;; The example is easier to read if you load this package and use C-h v
  78.   ;; to view the documentation.
  79.   "*List of regexps to fontify as additional SML keywords.
  80.  
  81. For example, to add `xfun', `xfn', `special', and `=>', the value could be
  82.  
  83.     (\"\\=\\=\\=\\\\=\\=\\=\\<xfu?n\\\\|special\\\\>\" \"=>\")
  84.  
  85. The word delimiters in the first pattern prevent spurious highlighting
  86. of keywords embedded inside other words (e.g., we don't want the tail of
  87. `myxfun' to be highlighted).  You cannot use word delimiters with
  88. symbolic patterns, however, because only alphanumerics are defined as
  89. Emacs word constituents.  The second pattern would match the tail of a
  90. symbolic identifier such as `==>', which might not be what you want.")
  91.  
  92. (defvar sml-font-lock-standard-keywords
  93.   ;; Generated with Simon Marshall's make-regexp:
  94.   ;; (make-regexp
  95.   ;;  '("abstype" "and" "andalso" "as" "case" "datatype"
  96.   ;;    "else" "end" "eqtype" "exception" "do" "fn" "fun" "functor"
  97.   ;;    "handle" "if" "in" "include" "infix" "infixr" "let" "local" "nonfix"
  98.   ;;    "of" "op" "open" "orelse" "overload" "raise" "rec" "sharing" "sig"
  99.   ;;    "signature" "struct" "structure" "then" "type" "val" "where" "while"
  100.   ;;    "with" "withtype") t)
  101.  
  102.   "\\<\\(a\\(bstype\\|nd\\(\\|also\\)\\|s\\)\\|case\\|d\\(atatype\\|o\\)\\|\
  103. e\\(lse\\|nd\\|qtype\\|xception\\)\\|f\\(n\\|un\\(\\|ctor\\)\\)\\|\handle\\|\
  104. i\\([fn]\\|n\\(clude\\|fixr?\\)\\)\\|l\\(et\\|ocal\\)\\|nonfix\\|\
  105. o\\([fp]\\|pen\\|relse\\|verload\\)\\|r\\(aise\\|ec\\)\\|\
  106. s\\(haring\\|ig\\(\\|nature\\)\\|truct\\(\\|ure\\)\\)\\|t\\(hen\\|ype\\)\\|\
  107. val\\|w\\(h\\(ere\\|ile\\)\\|ith\\(\\|type\\)\\)\\)\\>"
  108.  
  109.   "Regexp matching standard SML keywords.")
  110.  
  111. (defvar sml-font-lock-all nil
  112.   "Font-lock matchers for SML.")
  113.  
  114. (defun sml-font-lock-setup ()
  115.   "Set buffer-local font-lock variables and possibly turn on font-lock."
  116.   (let ((new-font-lock (boundp 'font-lock-defaults)))
  117.     ;; If new-font-lock is t, use sml-font-comments-and-strings to do
  118.     ;; fontification of comments and strings.  Otherwise, do
  119.     ;; fontification using the SML syntax table (which will not always
  120.     ;; be correct).
  121.     (or sml-font-lock-all
  122.     (setq sml-font-lock-all
  123.           (append
  124.            (and new-font-lock (list (list 'sml-font-comments-and-strings)))
  125.            sml-font-lock-extra-keywords
  126.            (list (list sml-font-lock-standard-keywords 1
  127.                'font-lock-keyword-face)))))
  128.     (cond (new-font-lock
  129.        (make-local-variable 'font-lock-defaults)
  130.        (setq font-lock-defaults '(sml-font-lock-all t)))
  131.       (t
  132.        (setq font-lock-keywords sml-font-lock-all))))
  133.   (and sml-font-lock-auto-on (turn-on-font-lock)))
  134.  
  135. (add-hook 'sml-mode-hook 'sml-font-lock-setup)
  136.  
  137. (defvar sml-font-cache '((0 . normal))
  138.   "List of (POSITION . STATE) pairs for an SML buffer.
  139. The STATE is either `normal', `comment', or `string'.  The POSITION is
  140. immediately after the token that caused the state change.")
  141.  
  142. (make-variable-buffer-local 'sml-font-cache)
  143.  
  144. (defun sml-font-comments-and-strings (limit)
  145.   "Fontify SML comments and strings up to LIMIT.
  146. Handles nested comments and SML's escapes for breaking a string over lines.
  147. Uses sml-font-cache to maintain the fontification state over the buffer."
  148.   (let ((beg (point))
  149.     last class)
  150.     (while (< beg limit)
  151.       (while (and sml-font-cache
  152.           (> (car (car sml-font-cache)) beg))
  153.     (setq sml-font-cache (cdr sml-font-cache)))
  154.       (setq last (car (car sml-font-cache)))
  155.       (setq class (cdr (car sml-font-cache)))
  156.       (goto-char last)
  157.       (cond
  158.        ((eq class 'normal)
  159.     (cond
  160.      ((not (re-search-forward "\\((\\*\\)\\|\\(\"\\)" limit t))
  161.       (goto-char limit))
  162.      ((match-beginning 1)
  163.       (setq sml-font-cache (cons (cons (point) 'comment) sml-font-cache)))
  164.      ((match-beginning 2)
  165.       (setq sml-font-cache (cons (cons (point) 'string) sml-font-cache)))))
  166.        ((eq class 'comment)
  167.     (cond
  168.      ((let ((nest 1))
  169.         (while (and (> nest 0)
  170.             (re-search-forward "\\((\\*\\)\\|\\(\\*)\\)" limit t))
  171.           (cond
  172.            ((match-beginning 1) (setq nest (+ nest 1)))
  173.            ((match-beginning 2) (setq nest (- nest 1)))))
  174.         (> nest 0))
  175.       (goto-char limit))
  176.      (t
  177.       (setq sml-font-cache (cons (cons (point) 'normal) sml-font-cache))))
  178.     (put-text-property (- last 2) (point) 'face 'font-lock-comment-face))
  179.        ((eq class 'string)
  180.     (while (and (re-search-forward
  181.              "\\(\"\\)\\|\\(\\\\\\s-*\\\\\\)\\|\\(\\\\\"\\)" limit t)
  182.              (not (match-beginning 1))))
  183.     (cond
  184.      ((match-beginning 1)
  185.       (setq sml-font-cache (cons (cons (point) 'normal) sml-font-cache)))
  186.      (t
  187.       (goto-char limit)))
  188.     (put-text-property (- last 1) (point) 'face 'font-lock-string-face)))
  189.       (setq beg (point)))))
  190.  
  191. (provide 'sml-font)
  192.